unit AVAnime;

interface

uses SysUtils, AVThread, AVUtils, Rtti, AVGenerics, Generics.Collections,
     Windows, Graphics, AVTypes;

type

  TAVAnimeContext = class;

  TAVAnimeSpeed = (sSlow, sMedium, sFast);
  TAVAnimeMode = (mNormal, mInc, mDec);
  TAVAnimeType = (aInt, aColor);

  TAVAnimeJob = record
    Path: string;
    value: TValue;
    mode: TAVAnimeMode;
    time: integer;
    CompleteOnCancel: boolean;
    IsWait: boolean;
    AnimeType: TAVAnimeType;
  end;

  TAVAnime = record
    fobj: TObject;
    fJobs: TAVArray<TAVAnimeJob>;
    fDefTime: integer;
    fDefMode: TAVAnimeMode;
    fID: string;
  private
    fCurrent: integer;
  public
    class operator Explicit(obj: TObject): TAVAnime;

    class var SlowTime: integer;
    class var MediumTime: integer;
    class var FastTime: integer;
    class var IterationTime: integer;

    class function GetSpeedTime(speed: TAVAnimeSpeed): integer; static;
    class function GetIterations(time: integer): integer; static;

    class constructor Create;

    function time(tm: integer): TAVAnime;
    function speed(sp: TAVAnimeSpeed): TAVAnime;
    function mode(md: TAVAnimeMode): TAVAnime;

    function Int(Path: string; value: TValue; mode: TAVAnimeMode; time: integer; CompleteOnCancel: boolean): TAVAnime; overload;
    function Int(Path: string; value: TValue; mode: TAVAnimeMode; speed: TAVAnimeSpeed; CompleteOnCancel: boolean): TAVAnime; overload;
    function Int(Path: string; value: TValue; mode: TAVAnimeMode): TAVAnime; overload;
    function Int(Path: string; value: TValue; speed: TAVAnimeSpeed): TAVAnime; overload;
    function Int(Path: string; value: TValue; time: integer): TAVAnime; overload;
    function Int(Path: string; value: TValue; CompleteOnCancel: boolean): TAVAnime; overload;
    function Int(Path: string; value: TValue): TAVAnime; overload;

    function Color(Path: string; value: TValue; mode: TAVAnimeMode; time: integer; CompleteOnCancel: boolean): TAVAnime; overload;
    function Color(Path: string; value: TValue; mode: TAVAnimeMode; speed: TAVAnimeSpeed; CompleteOnCancel: boolean): TAVAnime; overload;
    function Color(Path: string; value: TValue; mode: TAVAnimeMode): TAVAnime; overload;
    function Color(Path: string; value: TValue; speed: TAVAnimeSpeed): TAVAnime; overload;
    function Color(Path: string; value: TValue; time: integer): TAVAnime; overload;
    function Color(Path: string; value: TValue; CompleteOnCancel: boolean): TAVAnime; overload;
    function Color(Path: string; value: TValue): TAVAnime; overload;

    function Wait(time: integer): TAVAnime; overload;
    function Wait(speed: TAVAnimeSpeed): TAVAnime; overload;
    function Wait: TAVAnime; overload;

    procedure Run(context: TAVAnimeContext);
    procedure Cancel(context: TAVAnimeContext);

    procedure First;
    procedure Next;
    function EOF: boolean;
    function Current: TAVAnimeJob;
  end;

  TAVAnimeJobObj = class
  public
    Anime: TAVAnime;
    AnimeJob: TAVAnimeJob;
    constructor Create(anime: TAVAnime);
  end;

  TSizeCalculator = record
  private
    DecKoef: real;
    IncKoef: real;
    sizeChange: integer;
    speedMode: TAVAnimeMode;
    iteration: integer;
    step: real;
    iterationLeft: integer;
    current: real;
    function NotNormalStep(koef: real): real;
    procedure CalcFirst;
    procedure CalcNext;
  public
    constructor Create(sizeChange: integer; speedMode: TAVAnimeMode; iteration: integer);
    function NextSize: integer;
  end;

  TStepProcesor = record
  private
    iterations: integer;
    time: integer;
    endtime: DWORD;
    leftiterations: integer;
    iStep: integer;
  public
    constructor Create(iterations: integer; time: integer);
    function Next: boolean;
  end;

  TAVAnimeContext = class(TAVThreadContext)
  private
    fObjJobs: TDictionary<TObject, TList<TAVAnime>>;
    function ObjList(obj: TObject): TList<TAVAnime>;
    procedure Execute(anime: TAVAnime);
    function AnimeIndex(anime: TAVAnime; list: TList<TAVAnime>): integer;
    //Thread pool:
    procedure ExecuteInPool(Thread: TAVPoolThread);
    procedure ExecuteCallback(Thread: TAVPoolThread);
    procedure ExecuteWait(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
    procedure ExecuteIntChange(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
    procedure ExecuteColorChange(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
  protected
    procedure RunAnime(anime: TAVAnime);
    procedure CancelAnime(anime: TAVAnime);
  public
    constructor Create;
    destructor Destroy; override;

    function GetProp(obj: TObject; PropName: string): integer;
    procedure SetProp(obj: TObject; PropName: string; value: integer);
    procedure AnimeComplete(anime: TAVAnime);
  end;

implementation

// TAVAnime

class constructor TAVAnime.Create;
begin
  SlowTime := 1000;
  MediumTime := 500;
  FastTime := 200;
  IterationTime := 40;
end;

class operator TAVAnime.Explicit(obj: TObject): TAVAnime;
begin
  Result.fobj := obj;
  Result.fDefMode := mNormal;
  Result.fDefTime := GetSpeedTime(sFast);
end;

class function TAVAnime.GetSpeedTime(speed: TAVAnimeSpeed): integer;
begin
  case speed of
    sFast:
      Result := FastTime;
    sMedium:
      Result := MediumTime;
    sSlow:
      Result := SlowTime;
  else
    Result := FastTime;
  end;
end;

class function TAVAnime.GetIterations(time: integer): integer;
begin
  Result := time div IterationTime;
end;

function TAVAnime.time(tm: integer): TAVAnime;
begin
  fDefTime := tm;
  Result := Self;
end;

function TAVAnime.speed(sp: TAVAnimeSpeed): TAVAnime;
begin
  fDefTime := GetSpeedTime(sp);
  Result := Self;
end;

function TAVAnime.mode(md: TAVAnimeMode): TAVAnime;
begin
  fDefMode := md;
  Result := Self;
end;

function TAVAnime.Int(Path: string; value: TValue; mode: TAVAnimeMode; time: integer; CompleteOnCancel: boolean): TAVAnime;
var
  job: TAVAnimeJob;
begin
  job.AnimeType := aInt;
  job.Path := Path;
  job.value := value;
  job.mode := mode;
  job.time := time;
  job.CompleteOnCancel := CompleteOnCancel;
  job.IsWait := false;
  fJobs.Add(job);
  Result := Self;
end;

function TAVAnime.Int(Path: string; value: TValue; mode: TAVAnimeMode; speed: TAVAnimeSpeed; CompleteOnCancel: boolean): TAVAnime;
begin
  Result := Int(Path, value, mode, GetSpeedTime(speed), CompleteOnCancel);
end;

function TAVAnime.Int(Path: string; value: TValue; mode: TAVAnimeMode): TAVAnime;
begin
  Result := Int(Path, value, mode, fDefTime, false);
end;

function TAVAnime.Int(Path: string; value: TValue; speed: TAVAnimeSpeed): TAVAnime;
begin
  Result := Int(Path, value, mNormal, GetSpeedTime(speed), false);
end;

function TAVAnime.Int(Path: string; value: TValue; time: integer): TAVAnime;
begin
  Result := Int(Path, value, fDefMode, time, false);
end;

function TAVAnime.Int(Path: string; value: TValue; CompleteOnCancel: boolean): TAVAnime;
begin
  Result := Int(Path, value, fDefMode, fDefTime, CompleteOnCancel);
end;

function TAVAnime.Int(Path: string; value: TValue): TAVAnime;
begin
  Result := Int(Path, value, fDefMode, fDefTime, false);
end;

function TAVAnime.Color(Path: string; value: TValue; mode: TAVAnimeMode; time: integer; CompleteOnCancel: boolean): TAVAnime;
var
  job: TAVAnimeJob;
begin
  job.AnimeType := aColor;
  job.Path := Path;
  job.value := value;
  job.mode := mode;
  job.time := time;
  job.CompleteOnCancel := CompleteOnCancel;
  job.IsWait := false;
  fJobs.Add(job);
  Result := Self;
end;

function TAVAnime.Color(Path: string; value: TValue; mode: TAVAnimeMode; speed: TAVAnimeSpeed; CompleteOnCancel: boolean): TAVAnime;
begin
  Result := Color(Path, value, mode, GetSpeedTime(speed), CompleteOnCancel);
end;

function TAVAnime.Color(Path: string; value: TValue; mode: TAVAnimeMode): TAVAnime;
begin
  Result := Color(Path, value, mode, fDefTime, false);
end;

function TAVAnime.Color(Path: string; value: TValue; speed: TAVAnimeSpeed): TAVAnime;
begin
  Result := Color(Path, value, mNormal, GetSpeedTime(speed), false);
end;

function TAVAnime.Color(Path: string; value: TValue; time: integer): TAVAnime;
begin
  Result := Color(Path, value, fDefMode, time, false);
end;

function TAVAnime.Color(Path: string; value: TValue; CompleteOnCancel: boolean): TAVAnime;
begin
  Result := Color(Path, value, fDefMode, fDefTime, CompleteOnCancel);
end;

function TAVAnime.Color(Path: string; value: TValue): TAVAnime;
begin
  Result := Color(Path, value, fDefMode, fDefTime, false);
end;

function TAVAnime.Wait(time: integer): TAVAnime;
var job : TAVAnimeJob;
begin
  job.Path := '';
  job.time := time;
  job.IsWait := true;
  fJobs.Add(job);
  Result := Self;
end;

function TAVAnime.Wait(speed: TAVAnimeSpeed): TAVAnime;
begin
  Wait(GetSpeedTime(speed));
end;

function TAVAnime.Wait: TAVAnime;
begin
  Wait(fDefTime);
end;

procedure TAVAnime.Run(context: TAVAnimeContext);
begin
  fCurrent := 0;
  context.RunAnime(Self);
end;

procedure TAVAnime.Cancel(context: TAVAnimeContext);
begin
  context.CancelAnime(self);
end;

procedure TAVAnime.First;
begin
  fCurrent := 0;
end;

procedure TAVAnime.Next;
begin
  Inc(fCurrent);
end;

function TAVAnime.EOF: boolean;
begin
  Result := fCurrent >= fJobs.Count;
end;

function TAVAnime.Current: TAVAnimeJob;
begin
  if fCurrent < fJobs.Count then Result := fJobs[fCurrent];
end;

//TAVAnimeJobObj

constructor TAVAnimeJobObj.Create(anime: TAVAnime);
begin
  inherited Create;
  Self.Anime := anime;
  Self.AnimeJob := anime.Current;
end;

//TSizeCalculator

constructor TSizeCalculator.Create(sizeChange: integer; speedMode: TAVAnimeMode; iteration: integer);
begin
  DecKoef := 2.5;
  IncKoef := 1/DecKoef;
  Self.sizeChange := sizeChange;
  self.speedMode := speedMode;
  if iteration > 0
    then self.iteration := iteration
    else self.iteration := 1;
  iterationLeft := self.iteration;
  current := 0;
  CalcFirst;
end;

function TSizeCalculator.NotNormalStep(koef: real): real;
var d: real;
begin
  if iterationLeft <= 0 then Exit(sizeChange - current);
  d := (sizeChange - current)/iterationLeft*koef;
  if ((sizeChange < 0) and (d > 0)) or ((sizeChange > 0) and (d < 0)) then d := 0;
  Result := d;
end;

procedure TSizeCalculator.CalcFirst;
begin
  case speedMode of
    mNormal:
      if iteration <= 0
        then step := sizeChange
        else step := sizeChange/iteration;
    mDec:
      step := NotNormalStep(DecKoef);
    mInc:
      step := NotNormalStep(IncKoef);
  end;
  current := step;
  Dec(iterationLeft);
end;

procedure TSizeCalculator.CalcNext;
begin
  case speedMode of
    mNormal:
      current := current + step;
    mDec:
      begin
        step := NotNormalStep(DecKoef);
        current := current + step;
      end;
    mInc:
      begin
        step := NotNormalStep(IncKoef);
        current := current + step;
      end;
  end;
  Dec(iterationLeft);
end;

function TSizeCalculator.NextSize: integer;
var n: integer;
begin
  n := Trunc(current);
  CalcNext;
  if (sizeChange > 0) and (n > sizeChange) then n := sizeChange;
  if (sizeChange < 0) and (n < sizeChange) then n := sizeChange;
  Result := n;
end;

//TStepProcesor

constructor TStepProcesor.Create(iterations: integer; time: integer);
begin
  self.iterations := iterations;
  self.time := time;
  endtime := GetTickCount + time;
  leftiterations := self.iterations;
  iStep := 0;
end;

function TStepProcesor.Next: boolean;
var t: DWord;
    curTick: DWord;
begin
  Dec(leftiterations);
  if leftiterations <= 0
    then t := 0
    else begin
      curTick := GetTickCount;
      if endtime > curTick
        then t := Trunc((endtime - curTick)/leftiterations)
        else t := 0;
    end;
  if (t > 0) then begin
    Sleep(t);
  end;
  Inc(iStep);
  Result := iStep < iterations
end;

// TAVAnimeContext

constructor TAVAnimeContext.Create;
begin
  inherited Create;
  if AVThreadPool.MinThreadCount < 10 then
    AVThreadPool.MinThreadCount := 10;
  fObjJobs := TDictionary<TObject,TList<TAVAnime>>.Create;
end;

destructor TAVAnimeContext.Destroy;
var list: TList<TAVAnime>;
begin
  CancelAll;
  for list in fObjJobs.Values do list.Free;
  fObjJobs.Free;
  inherited Destroy;
end;

function TAVAnimeContext.ObjList(obj: TObject): TList<TAVAnime>;
begin
  if not fObjJobs.TryGetValue(obj, Result) then begin
    Result := TList<TAVAnime>.Create;
    fObjJobs.Add(obj, Result);
  end;
end;

function TAVAnimeContext.AnimeIndex(anime: TAVAnime; list: TList<TAVAnime>): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to list.Count - 1 do
    if list[i].fID = anime.fID then Exit(i);
end;

procedure TAVAnimeContext.AnimeComplete(anime: TAVAnime);
var
  list: TList<TAVAnime>;
  n: integer;
begin
  list := ObjList(anime.fobj);
  n := AnimeIndex(anime, list);
  if n >= 0 then list.Delete(n);
end;

procedure TAVAnimeContext.Execute(anime: TAVAnime);
var group: string;
begin
  anime.First;
  if anime.EOF then begin AnimeComplete(anime); exit; end;
  group := IntToStr(NativeInt(anime.fobj)) + '.' + anime.fID;
  AddJob(ExecuteInPool, TAVAnimeJobObj.Create(anime), group, '', ExecuteCallback);
end;

procedure TAVAnimeContext.RunAnime(anime: TAVAnime);
var list: TList<TAVAnime>;
begin
  list := ObjList(anime.fobj);
  anime.fID := GUIDToString(NewGuid);
  list.Add(anime);
  Execute(anime);
end;

procedure TAVAnimeContext.CancelAnime(anime: TAVAnime);
begin
  Cancel(IntToStr(NativeInt(anime.fobj)));
end;

procedure TAVAnimeContext.ExecuteWait(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
var i, n: integer;
begin
  if Thread.Job.Cancel then exit;
  n := JobData.AnimeJob.time div 20;
  for i := 0 to n - 1 do begin
    Sleep(20);
    if Thread.Job.Cancel then break;
  end;
  if not Thread.Job.Cancel then Sleep(JobData.AnimeJob.time mod 20);
end;

procedure TAVAnimeContext.ExecuteIntChange(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
var
  iterations: integer;
  currValue: integer;
  changeSize: integer;
  calc: TSizeCalculator;
  procesor: TStepProcesor;
  up: boolean;
  newSize, prevSize: integer;
begin
  iterations := TAVAnime.GetIterations(JobData.AnimeJob.time);
  currValue := Thread.Synchronize('GetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path]).AsInteger;
  changeSize := JobData.AnimeJob.value.AsInteger - currValue;
  calc := TSizeCalculator.Create(changeSize, JobData.AnimeJob.mode, iterations);
  procesor := TStepProcesor.Create(iterations, JobData.AnimeJob.time);
  up := changeSize > 0;
  prevSize := currValue;

  repeat
    newSize := currValue + calc.NextSize;
    if (up and (newSize > JobData.AnimeJob.value.AsInteger)) or
       (not up and (newSize < JobData.AnimeJob.value.AsInteger))
    then newSize := JobData.AnimeJob.value.AsInteger;
    if Thread.Job.Cancel then break;
    if newSize <> prevSize
      then Thread.Synchronize('SetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path, newSize]);
    prevSize := newSize;
  until not procesor.Next;

  if (newSize <> JobData.AnimeJob.value.AsInteger) then begin
    if not Thread.Job.Cancel or JobData.AnimeJob.CompleteOnCancel
      then Thread.Synchronize('SetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path, JobData.AnimeJob.value]);
  end;
end;

procedure TAVAnimeContext.ExecuteColorChange(Thread: TAVPoolThread; JobData: TAVAnimeJobObj);
var
  controlColor: TColor;
  iterations: integer;
  calc: TSizeCalculator;
  procesor: TStepProcesor;
  newColor, prevColor: TColor;
begin
  controlColor := Thread.Synchronize('GetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path]).AsType<TColor>;
  iterations := TAVAnime.GetIterations(JobData.AnimeJob.time);
  calc := TSizeCalculator.Create(100, JobData.AnimeJob.mode, iterations);
  procesor := TStepProcesor.Create(iterations, JobData.AnimeJob.time);
  prevColor := controlColor;

  repeat
    newColor := MergeColor(controlColor, JobData.AnimeJob.value.AsType<TColor>, calc.NextSize);
    if Thread.Job.Cancel then break;
    if newColor <> prevColor
      then Thread.Synchronize('SetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path, newColor]);
    prevColor := newColor;
  until not procesor.Next;

  if (newColor <> JobData.AnimeJob.value.AsType<TColor>) then begin
    if not Thread.Job.Cancel or JobData.AnimeJob.CompleteOnCancel
      then Thread.Synchronize('SetProp', [JobData.Anime.fobj, JobData.AnimeJob.Path, JobData.AnimeJob.value]);
  end;
end;

function TAVAnimeContext.GetProp(obj: TObject; PropName: string): integer;
begin
  Result := TAVRttiObj(obj)[PropName].AsInteger;
end;

procedure TAVAnimeContext.SetProp(obj: TObject; PropName: string; value: integer);
begin
  TAVRttiObj(obj)[PropName] := value;
end;

procedure TAVAnimeContext.ExecuteInPool(Thread: TAVPoolThread);
var
  JobData: TAVAnimeJobObj;
begin
  Thread.SyncInstance := Self;
  JobData := TAVAnimeJobObj(Thread.Job.Data);
  if JobData.AnimeJob.IsWait then ExecuteWait(Thread, JobData)
    else case JobData.AnimeJob.AnimeType of
      aInt: ExecuteIntChange(Thread, JobData);
      aColor: ExecuteColorChange(Thread, JobData);
    end;
end;

procedure TAVAnimeContext.ExecuteCallback(Thread: TAVPoolThread);
var
  JobData: TAVAnimeJobObj;
begin
  JobData := TAVAnimeJobObj(Thread.Job.Data);
  JobData.Anime.Next;
  if not JobData.Anime.EOF then begin
    AddJob(ExecuteInPool, TAVAnimeJobObj.Create(JobData.Anime), Thread.Job.Group, '', ExecuteCallback);
  end else begin
    Thread.Synchronize('AnimeComplete', [TValue.From<TAVAnime>(JobData.Anime)]);
  end;
end;

end.
